home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / bbs / mfm_111b.zip / MAXAREAS.PAS < prev    next >
Pascal/Delphi Source File  |  1992-01-07  |  4KB  |  159 lines
  1. Unit MaxAreas;
  2.  
  3. Interface
  4.  
  5. Const
  6.   MaxClass = 12;
  7.   MaxOvr = 16;
  8. Type
  9.   ArrayInPtr = ^ArrayInType;
  10.   ArrayInType = Array[1..255] Of Char;
  11.   Override = Record
  12.     Priv : Integer;
  13.     Lock1, lock2 : Word;
  14.     Ch : Char;
  15.     Fill : Byte;
  16.   End;
  17.   AreaRecordType = Record
  18.     Id : Array[1..4] Of Char;
  19.     StructLen : Word;
  20.     AreaNo : Array[1..2] Of Char;
  21.     Name : Array[1..40] Of Char;
  22.     AreaType : Word;
  23.     MsgPath : Array[1..80] Of Char;
  24.     MsgName : Array[1..40] Of Char;
  25.     MsgInfo, MsgBar : Array[1..80] Of Char;
  26.     Origin : Array[1..62] Of Char;
  27.     MsgPriv : Integer;
  28.     MsgLock, Fill1 : Byte;
  29.     OriginAka : Word;
  30.     FilePath, UpPath, FileBar, FilesBbs, FileInfo : Array[1..80] Of Char;
  31.     FilePriv : Integer;
  32.     FileLock, Fill2 : Byte;
  33.     MsgMenuName, FileMenuName : Array[1..13] Of Char;
  34.     Attrib : Array[1..MaxClass] Of Word;
  35.     Movr : Array[1..MaxOvr] Of Override;
  36.     Fovr : Array[1..MaxOvr] Of Override;
  37.     MsgLock1, MsgLock2, FileLock1, FileLock2 : Word;
  38.     KillByAge, KillByNum : Word;
  39.   End;
  40. Var
  41.   AreaPath : String[80];
  42.   StructLen : Word;
  43.   TotalAreas : Word;
  44.   AreaDatOpen : Boolean;
  45.   RecordBuffer : Pointer;
  46.  
  47. Function OpenMaxArea : Boolean;
  48. Function GetMaxArea(AreaNo : LongInt) : Byte;
  49. Function PutMaxArea(AreaNo : LongInt) : Byte;
  50. Procedure CloseMaxArea;
  51. Function Array2String(ArrayIn : ArrayInPtr) : String;
  52. Procedure String2Array(ArrayOut : ArrayInPtr; InString : String; ArraySize : Byte);
  53.  
  54. Implementation
  55.  
  56. Uses
  57.   Crt, Dos;
  58. Var
  59.   DirInfo : SearchRec;
  60.   AreaDat : File;
  61. {========================================================================}
  62. Function OpenMaxArea : Boolean;
  63.   Begin
  64.     If Not AreaDatOpen Then
  65.     Begin
  66.       FindFirst(AreaPath,Archive,DirInfo);
  67.       If DosError <> 0 Then
  68.       Begin
  69.         StructLen := 0;
  70.         TotalAreas := 0;
  71.         AreaDatOpen := False;
  72.       End
  73.       Else
  74.       Begin
  75.         Assign(AreaDat,AreaPath);
  76.         FileMode := 64;
  77.         Reset(AreaDat,1);
  78.         Seek(AreaDat,4);
  79.         BlockRead(AreaDat,StructLen,SizeOf(StructLen));
  80.         TotalAreas := FileSize(AreaDat) Div StructLen;
  81.         GetMem(RecordBuffer,StructLen);
  82.         AreaDatOpen := True;
  83.       End;
  84.     End;
  85.     OpenMaxArea := AreaDatOpen;
  86.   End;
  87. {========================================================================}
  88. Function GetMaxArea(AreaNo : LongInt) : Byte;
  89.   Begin
  90.     If OpenMaxArea Then
  91.     Begin
  92.       If (StructLen*AreaNo) > FileSize(AreaDat) Then
  93.       Begin
  94.         GetMaxArea := 254;
  95.       End
  96.       Else
  97.       Begin
  98.         Seek(AreaDat,StructLen*(AreaNo-1));
  99.         BlockRead(AreaDat,RecordBuffer^,StructLen);
  100.         GetMaxArea := 0;
  101.       End;
  102.     End;
  103.   End;
  104. {========================================================================}
  105. Function PutMaxArea(AreaNo : LongInt) : Byte;
  106.   Begin
  107.     If OpenMaxArea Then
  108.     Begin
  109.       If (StructLen*AreaNo) > FileSize(AreaDat) Then
  110.       Begin
  111.         PutMaxArea := 254;
  112.       End
  113.       Else
  114.       Begin
  115.         Seek(AreaDat,StructLen*(AreaNo-1));
  116.         BlockWrite(AreaDat,RecordBuffer^,StructLen);
  117.         PutMaxArea := 0;
  118.       End;
  119.     End;
  120.   End;
  121. {========================================================================}
  122. Procedure CloseMaxArea;
  123.   Begin
  124.     If AreaDatOpen Then
  125.     Begin
  126.       Close(AreaDat);
  127.       FreeMem(RecordBuffer,StructLen);
  128.       AreaDatOpen := False;
  129.     End;
  130.   End;
  131. {========================================================================}
  132. Function Array2String(ArrayIn : ArrayInPtr) : String;
  133.   Var
  134.     Asx : Byte;
  135.     Ass : String;
  136.   Begin
  137.     Asx := 1;
  138.     While ArrayIn^[Asx] <> #0 Do
  139.     Begin
  140.       Ass[Asx] := ArrayIn^[Asx];
  141.       Inc(Asx);
  142.     End;
  143.     Ass[0] := Char(Asx-1);
  144.     Array2String := Ass;
  145.   End;
  146. {========================================================================}
  147. Procedure String2Array(ArrayOut : ArrayInPtr; InString : String; ArraySize : Byte);
  148.   Var
  149.     Sab : Byte;
  150.   Begin
  151.     For Sab := 1 To ArraySize Do ArrayOut^[Sab] := #0;
  152.     For Sab := 1 To Length(InString) Do ArrayOut^[Sab] := InString[Sab];
  153.   End;
  154. {========================================================================}
  155. Begin
  156.   AreaDatOpen := False;
  157. End.
  158. {========================================================================}
  159.